library(here)
library(tidyverse)
source(here("utils.R"))
source(here("experiments", "blocksworld-main", "analysis", "model-utils.R"))
target_dir <- here("experiments", "blocksworld-main", "results", "data-raw")

Anonymize data once

save_raw_without_prolific_id(target_dir, "results_13_blocksWorld-main_BG.csv",
                             "13_blocksWorld-main_BG")
## Parsed with column specification:
## cols(
##   .default = col_character(),
##   submission_id = col_double(),
##   age = col_double(),
##   endTime = col_double(),
##   experiment_id = col_double(),
##   question = col_logical(),
##   startTime = col_double(),
##   timeSpent = col_double(),
##   trial_number = col_double()
## )
## See spec(...) for full column specifications.
fn <- paste(target_dir, "results_anonymized_13_blocksWorld-main_BG.csv", 
            sep=.Platform$file.sep)
data <- preprocess_data(fn)
## [1] "read data from: /home/britta/UNI/Osnabrueck/conditionals-blocksworld/experiments/blocksworld-main/results/data-raw/results_anonymized_13_blocksWorld-main_BG.csv"
## Parsed with column specification:
## cols(
##   .default = col_character(),
##   submission_id = col_double(),
##   age = col_double(),
##   endTime = col_double(),
##   experiment_id = col_double(),
##   question = col_logical(),
##   startTime = col_double(),
##   timeSpent = col_double(),
##   trial_number = col_double()
## )
## See spec(...) for full column specifications.
## Warning: Expected 4 pieces. Missing pieces filled with `NA` in 200 rows
## [1, 2, 3, 4, 30, 31, 32, 33, 59, 60, 61, 62, 88, 89, 90, 91, 117, 118, 119,
## 120, ...].
# discard train data
data <- data %>% filter(trial_name == "slider_main")
nrow(data)
## [1] 5000
STIMULI <- data %>% ungroup() %>% pull(stimulus_id) %>% unique()

Statistics of data

e.g. time, age, gender

# duration
df <- data %>% ungroup() %>% select(participant_id, timeSpent, age, gender,
                                    utterance, response, stimulus_id) %>%
  group_by(participant_id) %>% distinct()

df %>%  ungroup() %>%  select(timeSpent, age, gender) %>%  distinct() %>%
  summary()
##    timeSpent           age           gender  
##  Min.   : 7.927   Min.   :19.00   female:32  
##  1st Qu.:11.835   1st Qu.:28.50   male  :16  
##  Median :15.886   Median :35.50   other : 2  
##  Mean   :16.888   Mean   :37.72              
##  3rd Qu.:20.392   3rd Qu.:46.00              
##  Max.   :35.117   Max.   :68.00
df <- data %>%
  select(stimulus_id, participant_id, RT, utterance) %>% 
  pivot_wider(names_from = utterance, values_from = RT) %>% 
  pivot_longer(cols = c("b", "g", "bg", "gb"), names_to = "utterance",
               values_to = "RT") %>% 
  group_by(stimulus_id, utterance) %>% 
  mutate(sd_rt=sd(RT), RT=mean(RT), RT=mean(RT)) %>% 
  select(-participant_id) %>% 
  distinct()

p <- df %>% ggplot(aes(x=stimulus_id, y=RT, fill=utterance)) +
  geom_bar(position="dodge", stat="identity") +
  theme(legend.position="bottom", axis.text.x = element_text(angle=90)) +
  ggtitle('Average Reaction Times per stimulus') +
  geom_hline(aes(yintercept = mean(df$RT)))

p

Look at comments

dat.comments <- data %>% ungroup() %>% select(comments, participant_id)
dat.comments %>% select(comments) %>% unique()
c <- dat.comments %>% filter(str_detect(comments, "Initially.*")) %>% distinct() 
pid <- c %>% pull(participant_id)
c %>% pull(comments)
## [1] "Initially, I was glossing over the fact that the \"if\" statements were wrong. I was answering affirmatively if they ensconced the falling of both bricks for example, if they were both expected to fall. Eventually, I realized that I should be answering in the negative when the statement contained false consequences. (What this brick does has nothing to do with what that one does.)"

Process data

Account for different color-groups

# match colors and blocks depending on color-group
data_processed <- data %>%
  group_by(participant_id, stimulus_id, color_group) %>% 
  mutate(utterance =  case_when(color_group=="group1" & utterance=="b" ~ "A",
                              color_group=="group1" & utterance=="g" ~ "C",
                              color_group=="group1" & utterance=="bg" ~ "A > C",
                              color_group=="group1" & utterance=="gb" ~ "C > A",
                              color_group=="group2" & utterance=="b" ~ "C", 
                              color_group=="group2" & utterance=="g" ~ "A",
                              color_group=="group2" & utterance=="bg" ~ "C > A",
                              color_group=="group2" & utterance=="gb" ~ "A > C"
                              ),
       utterance=factor(utterance, levels = c("A", "C", "A > C", "C > A")),
       response = response/100) %>%
  ungroup() %>% select(-color_group)

Discard irrelevant columns

data_processed <- data_processed %>% select(-RT, -trial_name, -timeSpent,
                                            -gender, -age, -utt_idx)

Filter data

Are there any unacceptable trials?

# participants who didn't accept any utterance at all
data_filtered <- data_processed %>% group_by(participant_id, trial_number) %>%
  mutate(s=sum(response)) %>% filter(s!=0) %>% select(-s)

nrow(data_filtered)
## [1] 4848

Critical Trials

Check for critical trials where minimal requirements are not fulfilled.

If at least one block clearly touches or clearly doesn’t touch the ground, but participant put low/high probability on utterance “A/C will touch the ground”, discard trial, in these cases participants cannot have been concentrated. To check this, use normalized data!

Again, control trials seem to be necessary to avoid this.

df <- data_filtered %>%
  group_by(participant_id, stimulus_id) %>% 
  filter(sum(response) != 0)
nrow(df)
## [1] 4848
data_normalized <- df %>% mutate(n=sum(response), response.norm=response/n) %>%
  select(-response)

The following picture show the scenes for which requirements were specified.

“S12-203”

“S12-203”

“S22-468”

“S22-468”

“S30-805”

“S30-805”

“S32-806”

“S32-806”

“S57-1007”

“S57-1007”

“S7-130”

“S7-130”

fn <- "scenes_luh_annotations.csv"
min.require <- read_csv(here("experiments", "stimuli", fn)) %>%
  select(req.exp2.not.small, req.exp2.not.large, id) %>% 
  filter((!is.na(req.exp2.not.small) | !is.na(req.exp2.not.large)))

data_normalized_wide <- data_normalized %>%
  select(-trial_number) %>% 
  group_by(participant_id, stimulus_id) %>% 
  pivot_wider(names_from = utterance, values_from = response.norm)

check <- function(data_wide, stimulus){
  req <- min.require %>% filter(id== (!!stimulus))
  dat <- tibble()
  if(nrow(req) != 0){
    not_small <- req$`req.exp2.not.small`
    not_large <- req$`req.exp2.not.large`
    
    dat <- data_wide %>% filter(stimulus_id==(!!stimulus)) 
    if(!is.na(not_small)) {
      if(str_detect(not_small, "A.*")){
        dat <- dat %>% filter(A < 0.2)
        if(not_small == "A_C"){
          dat <- dat %>% filter(C < 0.2)
        }
      } 
      dat <- dat %>% filter(C < 0.2)
    }
    if(!is.na(not_large)){
      if(str_detect(not_large, "A.*")){
        dat <- dat %>% filter(A > 0.8)
        if(not_large == "A_C"){
          dat <- dat %>% filter(C > 0.8)
        }
      } 
      dat <- dat %>% filter(C > 0.8)
    }
  }
  return(dat)
}

critical <- tibble()
for (s in STIMULI){
  t <- check(data_normalized_wide, s)
  critical <- bind_rows(critical, t)
}

critical
data_normalized <- anti_join(data_normalized_wide, critical) %>% 
  pivot_longer(cols = c("A", "C", "A > C", "C > A"), names_to = "utterance",
               values_to = "response")

# undo normalization
data_filtered <- data_normalized %>% mutate(response=response*n)
nrow(data_filtered)
## [1] 4848

Discard data if necessary

Filter if something went wrong according to comments

# filter if-trials for that participant
data_filtered <- data_filtered %>%
  filter(participant_id != pid | (utterance=="A" | utterance =="C"))

data_filtered <- data_filtered %>%
  select(-comments, -n) %>% 
  ungroup() %>% 
  mutate(utterance=factor(utterance)) %>% 
  group_by(stimulus_id, participant_id) %>% 
  arrange(participant_id, stimulus_id, utterance, response)

nrow(data_filtered)
## [1] 4808
nrow(data_filtered) / nrow(data)
## [1] 0.9616

Save data

dir_name <- here("experiments", "blocksworld-main", "results", "data-processed")
dir.create(dir_name, showWarnings=FALSE, recursive = TRUE)

save_to <- paste(dir_name, "data_experimental.csv", sep=.Platform$file.sep)
write.table(data_filtered , file = save_to, sep = ",", row.names=FALSE)

means <- data_filtered %>% group_by(stimulus_id, utterance) %>%
  summarise(mean=mean(response))
fn <- "data_experimental_means.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(means, file = save_to, sep = ",", row.names=FALSE)

# Also save a normalized version of the data, such that all four responses
# (slider values) sum up to 1.
fn <- "data_experimental_normalized.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(data_normalized , file = save_to, sep = ",", row.names=FALSE)

means <- data_normalized %>% group_by(stimulus_id, utterance) %>%
  summarise(mean=mean(response))
fn <- "data_experimental_normalized_means.csv"
save_to <- paste(dir_name, fn, sep=.Platform$file.sep)
write.table(means, file = save_to, sep = ",", row.names=FALSE)

Plot the data

labels <- c(`A > C`="If blue, green", A = "Blue will ttg", C="Green will ttg",
            `C > A` = "If green, blue")
dir_name <- here("experiments", "blocksworld-main", "results", "plots")
dir.create(dir_name, showWarnings=FALSE, recursive = TRUE)
for (s in STIMULI){
  df <- data_filtered %>% filter(stimulus_id == s) 
  df_means <- df %>% group_by(utterance) %>%
    summarise(m=mean(response), med=median(response))
  p <- df  %>% 
    ggplot(aes(x=factor(0), y=response, fill=utterance)) +
    geom_violin(alpha=0.5) +
    geom_jitter(width = 0.2, alpha=0.5) + 
    geom_point(data=df_means,  mapping=aes(x = factor(0), y = m), col="red") +
    geom_point(data=df_means,  mapping=aes(x=factor(0), y=med), col="yellow") +

    coord_flip() +
    labs(y="", x="") + 
    theme_classic() +
    
    facet_wrap(~utterance, labeller = labeller(utterance=labels)) + 
    # ggtitle(s) +
    theme(legend.position = "none", text = element_text(size=20),
          axis.text.y=element_blank(), axis.ticks.y =element_blank(),
          panel.spacing = unit(2, "lines"))
  fn <- paste("responses-", s, ".jpg", sep="")
  ggsave(paste(dir_name, fn, sep=.Platform$file.sep), p, width=5, height=4)
  print(p)
}